perm filename EVAL3.LSP[W78,JMC] blob
sn#339347 filedate 1978-03-09 generic text, type T, neo UTF8
(DEFUN FFEVAL (E A)
(COND ((ATOM E)
(COND ((EQ E NIL) NIL) ((EQ E T) T)
(T (CDR ((LABEL
FFASSOC
(LAMBDA (E A)
(COND ((NULL A) NIL)
((EQ E (CAAR A)) (CAR A))
(T (FFASSOC E (CDR A))))))
E
A)))))
((ATOM (CAR E))
(COND ((EQ (CAR E) 'QUOTE) (CADR E))
((EQ (CAR E) 'CAR)
(CAR (FFEVAL (CADR E) A)))
((EQ (CAR E) 'CDR)
(CDR (FFEVAL (CADR E) A)))
((EQ (CAR E) 'CADR)
(CADR (FFEVAL (CADR E) A)))
((EQ (CAR E) 'CADDR)
(CADDR (FFEVAL (CADR E) A)))
((EQ (CAR E) 'CAAR)
(CAAR (FFEVAL (CADR E) A)))
((EQ (CAR E) 'CADAR)
(CADAR (FFEVAL (CADR E) A)))
((EQ (CAR E) 'CADDAR)
(CADDAR (FFEVAL (CADR E) A)))
((EQ (CAR E) 'ATOM)
(ATOM (FFEVAL (CADR E) A)))
((EQ (CAR E) 'NULL)
(NULL (FFEVAL (CADR E) A)))
((EQ (CAR E) 'CONS)
(CONS (FFEVAL (CADR E) A) (FFEVAL (CADDR E) A)))
((EQ (CAR E) 'EQ)
(EQ (FFEVAL (CADR E) A) (FFEVAL (CADDR E) A)))
((EQ (CAR E) 'COND)
((LABEL FFEVCOND
(LAMBDA (U A) (COND ((FFEVAL (CAAR U) A)
(FFEVAL (CADAR U)
A))
(T (FFEVCOND (CDR U)
A)))))
(CDR E)
A))
(T (FFEVAL (CONS (CDR ((LABEL
FFASSOC
(LAMBDA (E A)
(COND
((NULL A) NIL)
((EQ E (CAAR A))
(CAR A))
(T (FFASSOC E
(CDR A))))))
(CAR E)
A))
(CDR E))
A))))
((EQ (CAAR E) 'LAMBDA)
(FFEVAL (CADDAR E)
((LABEL FFAPPEND
(LAMBDA (U V)
(COND ((NULL U) V)
(T (CONS (CAR U)
(FFAPPEND (CDR
U) V))))))
((LABEL
PAIRUP
(LAMBDA (U V)
(COND ((NULL U) NIL)
(T (CONS (CONS (CAR U) (CAR V))
(PAIRUP (CDR U)
(CDR V)))))))
(CADAR E)
((LABEL
FFEVLIS
(LAMBDA (U A)
(COND ((NULL U) NIL)
(T (CONS (FFEVAL (CAR U) A)
(FFEVLIS (CDR U)
A))))))
(CDR E)
A))
A)))
((EQ (CAAR E) 'LABEL)
(FFEVAL (CONS (CADDAR E) (CDR E))
(CONS (CONS (CADAR E) (CAR E)) A)))))